home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / get_fi_1 / docprevi.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-07-04  |  38.6 KB  |  1,042 lines
  1. VERSION 5.00
  2. Begin VB.Form frmDocPreview 
  3.    BackColor       =   &H8000000B&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "Preview"
  6.    ClientHeight    =   6510
  7.    ClientLeft      =   1125
  8.    ClientTop       =   1500
  9.    ClientWidth     =   9780
  10.    Icon            =   "DocPreview.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    LockControls    =   -1  'True
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    PaletteMode     =   1  'UseZOrder
  16.    ScaleHeight     =   434
  17.    ScaleMode       =   3  'Pixel
  18.    ScaleWidth      =   652
  19.    Begin VB.CommandButton cmdZoomOut 
  20.       Height          =   405
  21.       Left            =   1680
  22.       Picture         =   "DocPreview.frx":030A
  23.       Style           =   1  'Graphical
  24.       TabIndex        =   18
  25.       ToolTipText     =   "Zoom out"
  26.       Top             =   60
  27.       Width           =   405
  28.    End
  29.    Begin VB.CommandButton cmdZoomIn 
  30.       Height          =   405
  31.       Left            =   1200
  32.       Picture         =   "DocPreview.frx":040C
  33.       Style           =   1  'Graphical
  34.       TabIndex        =   17
  35.       ToolTipText     =   "Zoom in"
  36.       Top             =   60
  37.       Width           =   405
  38.    End
  39.    Begin VB.CommandButton cmdPrint 
  40.       Height          =   405
  41.       Left            =   270
  42.       Picture         =   "DocPreview.frx":050E
  43.       Style           =   1  'Graphical
  44.       TabIndex        =   16
  45.       ToolTipText     =   "Print"
  46.       Top             =   60
  47.       Width           =   405
  48.    End
  49.    Begin VB.ComboBox cboScale 
  50.       BeginProperty Font 
  51.          Name            =   "MS Sans Serif"
  52.          Size            =   9.75
  53.          Charset         =   0
  54.          Weight          =   400
  55.          Underline       =   0   'False
  56.          Italic          =   0   'False
  57.          Strikethrough   =   0   'False
  58.       EndProperty
  59.       Height          =   360
  60.       Left            =   2220
  61.       Style           =   2  'Dropdown List
  62.       TabIndex        =   15
  63.       Top             =   60
  64.       Width           =   855
  65.    End
  66.    Begin VB.CommandButton cmdPrevPage 
  67.       Caption         =   "<"
  68.       BeginProperty Font 
  69.          Name            =   "MS Sans Serif"
  70.          Size            =   8.25
  71.          Charset         =   0
  72.          Weight          =   700
  73.          Underline       =   0   'False
  74.          Italic          =   0   'False
  75.          Strikethrough   =   0   'False
  76.       EndProperty
  77.       Height          =   345
  78.       Left            =   4200
  79.       TabIndex        =   14
  80.       ToolTipText     =   "Prev page"
  81.       Top             =   90
  82.       Width           =   315
  83.    End
  84.    Begin VB.CommandButton cmdNextPage 
  85.       Caption         =   ">"
  86.       BeginProperty Font 
  87.          Name            =   "MS Sans Serif"
  88.          Size            =   8.25
  89.          Charset         =   0
  90.          Weight          =   700
  91.          Underline       =   0   'False
  92.          Italic          =   0   'False
  93.          Strikethrough   =   0   'False
  94.       EndProperty
  95.       Height          =   345
  96.       Left            =   4560
  97.       TabIndex        =   13
  98.       ToolTipText     =   "Next page"
  99.       Top             =   90
  100.       Width           =   315
  101.    End
  102.    Begin VB.ComboBox cboPageNo 
  103.       BeginProperty Font 
  104.          Name            =   "MS Sans Serif"
  105.          Size            =   9.75
  106.          Charset         =   0
  107.          Weight          =   400
  108.          Underline       =   0   'False
  109.          Italic          =   0   'False
  110.          Strikethrough   =   0   'False
  111.       EndProperty
  112.       Height          =   360
  113.       Left            =   4890
  114.       Style           =   2  'Dropdown List
  115.       TabIndex        =   12
  116.       Top             =   60
  117.       Width           =   825
  118.    End
  119.    Begin VB.TextBox txtTotalPages 
  120.       BackColor       =   &H80000004&
  121.       BeginProperty Font 
  122.          Name            =   "MS Sans Serif"
  123.          Size            =   9.75
  124.          Charset         =   0
  125.          Weight          =   400
  126.          Underline       =   0   'False
  127.          Italic          =   0   'False
  128.          Strikethrough   =   0   'False
  129.       EndProperty
  130.       Height          =   345
  131.       Left            =   5760
  132.       Locked          =   -1  'True
  133.       TabIndex        =   11
  134.       Text            =   "txtTotalPages"
  135.       Top             =   60
  136.       Width           =   1395
  137.    End
  138.    Begin VB.CommandButton cmdClose 
  139.       Caption         =   "Close"
  140.       BeginProperty Font 
  141.          Name            =   "MS Sans Serif"
  142.          Size            =   8.25
  143.          Charset         =   0
  144.          Weight          =   700
  145.          Underline       =   0   'False
  146.          Italic          =   0   'False
  147.          Strikethrough   =   0   'False
  148.       EndProperty
  149.       Height          =   390
  150.       Left            =   8190
  151.       TabIndex        =   10
  152.       Top             =   60
  153.       Width           =   825
  154.    End
  155.    Begin VB.PictureBox PicZ 
  156.       BackColor       =   &H8000000D&
  157.       Height          =   5325
  158.       Left            =   60
  159.       ScaleHeight     =   5265
  160.       ScaleWidth      =   9285
  161.       TabIndex        =   2
  162.       Top             =   720
  163.       Width           =   9345
  164.       Begin VB.PictureBox Pic5 
  165.          BackColor       =   &H80000009&
  166.          Height          =   2295
  167.          Left            =   120
  168.          ScaleHeight     =   2235
  169.          ScaleWidth      =   2595
  170.          TabIndex        =   9
  171.          Top             =   120
  172.          Width           =   2655
  173.       End
  174.       Begin VB.PictureBox Pic4 
  175.          AutoRedraw      =   -1  'True
  176.          BackColor       =   &H80000009&
  177.          Height          =   2715
  178.          Left            =   150
  179.          ScaleHeight     =   2655
  180.          ScaleWidth      =   3015
  181.          TabIndex        =   8
  182.          Top             =   120
  183.          Width           =   3075
  184.       End
  185.       Begin VB.PictureBox Pic3 
  186.          AutoRedraw      =   -1  'True
  187.          BackColor       =   &H80000009&
  188.          Height          =   3285
  189.          Left            =   120
  190.          ScaleHeight     =   3225
  191.          ScaleWidth      =   3765
  192.          TabIndex        =   7
  193.          Top             =   90
  194.          Width           =   3825
  195.       End
  196.       Begin VB.PictureBox Pic2 
  197.          AutoRedraw      =   -1  'True
  198.          BackColor       =   &H80000009&
  199.          Height          =   3795
  200.          Left            =   90
  201.          ScaleHeight     =   3735
  202.          ScaleWidth      =   4515
  203.          TabIndex        =   6
  204.          Top             =   60
  205.          Width           =   4575
  206.       End
  207.       Begin VB.PictureBox Pic1 
  208.          AutoRedraw      =   -1  'True
  209.          BackColor       =   &H80000009&
  210.          Height          =   4215
  211.          Left            =   60
  212.          ScaleHeight     =   4155
  213.          ScaleWidth      =   5325
  214.          TabIndex        =   5
  215.          Top             =   30
  216.          Width           =   5385
  217.       End
  218.       Begin VB.PictureBox PicX 
  219.          AutoRedraw      =   -1  'True
  220.          BackColor       =   &H80000009&
  221.          Height          =   4695
  222.          Left            =   30
  223.          ScaleHeight     =   4635
  224.          ScaleWidth      =   6015
  225.          TabIndex        =   4
  226.          Top             =   0
  227.          Width           =   6075
  228.       End
  229.       Begin VB.PictureBox picP 
  230.          AutoRedraw      =   -1  'True
  231.          BackColor       =   &H80000009&
  232.          Height          =   5310
  233.          Left            =   0
  234.          ScaleHeight     =   5250
  235.          ScaleWidth      =   6885
  236.          TabIndex        =   3
  237.          Top             =   -30
  238.          Width           =   6945
  239.       End
  240.    End
  241.    Begin VB.VScrollBar VScroll1 
  242.       Height          =   5295
  243.       Left            =   9420
  244.       Max             =   500
  245.       TabIndex        =   0
  246.       Top             =   720
  247.       Width           =   330
  248.    End
  249.    Begin VB.HScrollBar HScroll1 
  250.       Height          =   330
  251.       Left            =   60
  252.       Max             =   500
  253.       TabIndex        =   1
  254.       Top             =   6060
  255.       Width           =   9345
  256.    End
  257. Attribute VB_Name = "frmDocPreview"
  258. Attribute VB_GlobalNameSpace = False
  259. Attribute VB_Creatable = False
  260. Attribute VB_PredeclaredId = True
  261. Attribute VB_Exposed = False
  262. '  DocPreview.frm
  263. '  By Herman Liu
  264. '  VB has not provided facilities to build print preview for RichTextBox which is used
  265. '  as document in a text editor.  Though there are a few print preview programs around,
  266. '  I have not come across any which is geared for RTB in VB context (If a programmer has
  267. '  to arbitrarily apply his/her own selected fonts, the resultant printout would never
  268. '  be able to reflect the document's original settings).
  269. '  Despite the many constraints of RTB in VB, we are able to add functions to RTB for a
  270. '  print preview or for printing page(s) selectively. This DocPreview shows how.
  271. '  The Source code is written in native VB. Forms and controls involved are: (1) MDI
  272. '  called frmFrame. A child form, called DocMaster, which contains a RTB. It is from
  273. '  this child form that the DocPreview is invoked . (2) a form for print preview, with
  274. '  MDIChild property set to False.  This DocPreview contains a "home-made" viewport which
  275. '  consists of several pictureboxes.  Controls placed outside the viewport are a horizontal
  276. '  scrollbar and a vertical scrollbar.  On top of the viewport are buttons and comboboxes:
  277. '  a "Zoom-in" button, a "Zoom-out" button, a combobox for preview sizes, another for list
  278. '  of available pages, a "Previous page" button, a "Next page" button, a "Print"  button
  279. '  and a "Close" button.
  280. '  A default value is given to gleftmargin, grightmargin, gtopmargin and gbottommargin
  281. '  respectively (a PageSetUp form shall allow users to change the values).
  282. '  Explanation of some key points:
  283. '  1.  In a RTB, a single line may have text formatted with different fonts, and there
  284. '      may be graphics in between as well. To capture the original contents and settings,
  285. '      we first "selprint" the selected page to a hidden picturebox (Since RTB does not
  286. '      have a hDC, we cannot "bitblt", nor paintpicture").  We then "stretchblt" that
  287. '      picturebox to other pictureboxes according to the desired sizes of preview.
  288. '      (SretchBlt differs to BitBlt in that it will stretch/shrink according to the
  289. '      scalewidth and scaleheight of the destination relative to the source).
  290. '  2.  Since selprint method does not allow a programmer to set the position of output on
  291. '      the printer. In addition, RTB does not provide a method for displaying its contents
  292. '      as they should show up on the printer. We have to set up a RTB similar to a WYSIWYG
  293. '      display before printing it.
  294. '  3.  Pictureboxes inside the viewport: PicZ is the base for all other pictureboxes. In
  295. '      order for the viewport to work, all these other pictureboxes must be placed inside
  296. '      PicZ only. At design stage, align all pictureboxes to a top-left corner of PicZ.
  297. '      N.B.: Before that, place PicP, PixX, 1, 2, 3, 4 & 5 individually inside PicZ first
  298. '      (but outside any other picturebox).  You don't have to size them as they will be
  299. '      resized at runtime (except for the base PicZ).
  300. '  4.  Before user is provided with options to select a particular page, there should be
  301. '      procedural mechanism to establish the total no. of pages.  There should also be
  302. '      arrangements to effect change of a user-selected page, both for display and for
  303. '      print to printer.
  304. '  All the above-mentioned are included in this sample program and the program can be run
  305. '  readily.
  306. '  You are allowed to use this program freely, but I would appreciate a due credit given.
  307. '  Please let me know if you have made any enhancement.
  308. Option Explicit
  309. Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, _
  310.     ByVal Y As Long, ByVal mDestWidth As Long, ByVal mDestHeight As Long, _
  311.     ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal mSrcWidth As Long, _
  312.     ByVal mSrcHeight As Long, ByVal dwRop As Long) As Long
  313. Private Const SRCCOPY = &HCC0020
  314. '-------------------------------------------------------------------------------------------------------------------
  315. ' By using the following messages in VB, it is possible to make a RichTextBox support WYSIWYG display and output:
  316. ' EM_SETTARGETDEVICE message is used to tell a RichTextBox to base its display on a target device.
  317. ' EM_FORMATRANGE message sends a page at a time to an output device using the specified coordinates.
  318. Private Type Rect
  319.     Left As Long
  320.     Top As Long
  321.     Right As Long
  322.     Bottom As Long
  323. End Type
  324. Private Type CharRange
  325.     firstChar As Long         ' First character of range (0 for start of doc)
  326.     lastChar As Long          ' Last character of range (-1 for end of doc)
  327. End Type
  328. Private Type FormatRange
  329.     hdc As Long               ' Actual DC to draw on
  330.     hdcTarget As Long         ' Target DC for determining text formatting
  331.     rectRegion As Rect        ' Region of the DC to draw to (in twips)
  332.     rectPage As Rect          ' Page size of the entire DC (in twips)
  333.     mCharRange As CharRange   ' Range of text to draw (see above user type)
  334. End Type
  335. Private Const WM_USER As Long = &H400
  336. Private Const EM_FORMATRANGE As Long = WM_USER + 57
  337. Private Const EM_SETTARGETDEVICE As Long = WM_USER + 72
  338. Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" _
  339.      (ByVal hwnd As Long, ByVal msg As Long, ByVal wp As Long, Ip As Any) As Long
  340.      
  341. Dim mFormatRange As FormatRange
  342. Dim rectDrawTo As Rect
  343. Dim rectPage As Rect
  344. Dim TextLength As Long
  345. Dim newStartPos As Long
  346. Dim dumpaway As Long
  347.      
  348. Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" _
  349.      (ByVal lpDriverName As String, ByVal lpDeviceName As String, _
  350.      ByVal lpOutput As Long, ByVal lpInitData As Long) As Long
  351. '-------------------------------------------------------------------------------------------------------------------
  352. Dim mNotShow As Boolean
  353. Dim mSizeNo As Integer
  354. Dim mTotalPages As Integer
  355. Private Sub Form_Load()
  356.    Screen.MousePointer = vbHourglass
  357.    gprint = False
  358.      ' we don't want the sizes to change after they have been appropriately sized
  359.    PicZ.AutoSize = False             ' Base, always visible
  360.    picP.AutoSize = False             ' For print intermediary, always invisible
  361.    PicX.AutoSize = False             ' For diaplay intermediary, always invisible
  362.    Pic1.AutoSize = False             ' As 150%
  363.    Pic2.AutoSize = False             ' As 100%
  364.    Pic3.AutoSize = False             ' As 75%
  365.    Pic4.AutoSize = False             ' As 50%
  366.    Pic5.AutoSize = False             ' As 25%
  367.        ' By default VB prints in twips. If a Picturebox is using pixels, we have to
  368.        ' convert twips in pixels.  Therefore we fix the size of Pictureboxes before
  369.        ' setting its ScaleMode to pixel (Eash pixel is about 15 twips, depending on
  370.        ' the resolution of device)
  371.       
  372.    Dim mNormalWidth, mNormalHeight
  373.    Dim mAdjFactor
  374.    Dim mRect, mNewRect, mfactor
  375.    Dim mpage As Integer
  376.       ' Render document size in line with that of the printer (but note that doc is
  377.       ' shown on screen without print margins)
  378.    DocWYSIWYG frmFrame.ActiveForm.ActiveControl
  379.       ' Obtain size of the printer
  380.    mNormalWidth = Printer.ScaleWidth
  381.    mNormalHeight = Printer.ScaleHeight
  382.       ' Due to diff of resolution between screen and printer, we may use an adjustment
  383.       ' factor, here we don't have any adjustment
  384.    mAdjFactor = 100 / 100
  385.    mNormalWidth = mNormalWidth * mAdjFactor
  386.    mNormalHeight = mNormalHeight * mAdjFactor
  387.       ' Mark down rectangle area, see remarks later
  388.    mRect = mNormalWidth * mNormalHeight
  389.       ' Make the invisible PicX of the same size as printer
  390.    PicX.Width = mNormalWidth
  391.    PicX.Height = mNormalHeight
  392.      ' Percentage may be expressed in terms of original area (in that case, we have
  393.      ' to derive the width and height from the computed area), or in terms of width
  394.      ' and height themselves.  Here, to stress the point, we apply the percentage
  395.      ' in terms of the area for sizes over 100%, but apply the percentage in terms
  396.      ' of the width and height themselves for sizes are below 100%.
  397.        ' Set 150%
  398.    mNewRect = mRect * (150 / 100)
  399.      ' By what percentage (factor) the width and the height should be reduced in order
  400.      ' to arrive at an area for the new rectangle?
  401.      ' (mNormalWidth * mfactor) * (mNormalHeight * mfactor) = mNewRect (mfactor Square)
  402.      ' * (mNormalWidth * mNormalHeight) = mNewRect
  403.    mfactor = Sqr(mNewRect / (mNormalWidth * mNormalHeight))
  404.    Pic1.Width = CInt(mNormalWidth * mfactor)
  405.    Pic1.Height = CInt(mNormalHeight * mfactor)
  406.        ' Set 100%
  407.    Pic2.Width = PicX.Width
  408.    Pic2.Height = PicX.Height
  409.        
  410.       ' Re remarks earlier, we choose not to derive width and height from area for
  411.       ' sizes below 100%.
  412.        ' Set 75%
  413.    Pic3.Width = CInt(mNormalWidth * 75 / 100)
  414.    Pic3.Height = CInt(mNormalHeight * 75 / 100)
  415.        ' Set 50%
  416.    Pic4.Width = CInt(mNormalWidth * 50 / 100)
  417.    Pic4.Height = CInt(mNormalHeight * 50 / 100)
  418.        ' Set 25%
  419.    Pic5.Width = CInt(mNormalWidth * 25 / 100)
  420.    Pic5.Height = CInt(mNormalHeight * 25 / 100)
  421.      ' Set ScaleMode to pixels.
  422.    frmDocPreview.ScaleMode = vbPixels
  423.    PicZ.ScaleMode = vbPixels
  424.    PicX.ScaleMode = vbPixels
  425.    Pic1.ScaleMode = vbPixels
  426.    Pic2.ScaleMode = vbPixels
  427.    Pic3.ScaleMode = vbPixels
  428.    Pic4.ScaleMode = vbPixels
  429.    Pic5.ScaleMode = vbPixels
  430.      ' Set AutoRedraw to True
  431.    PicZ.AutoRedraw = True
  432.    picP.AutoRedraw = True
  433.    PicX.AutoRedraw = True
  434.    Pic1.AutoRedraw = True
  435.    Pic2.AutoRedraw = True
  436.    Pic3.AutoRedraw = True
  437.    Pic4.AutoRedraw = True
  438.    Pic5.AutoRedraw = True
  439.     ' Set BorderStyle to Fixed Single
  440.    PicZ.BorderStyle = 1
  441.    PicX.BorderStyle = 1
  442.    Pic1.BorderStyle = 1
  443.    Pic2.BorderStyle = 1
  444.    Pic3.BorderStyle = 1
  445.    Pic4.BorderStyle = 1
  446.    Pic5.BorderStyle = 1
  447.     ' Set Fillstyle to Transparent
  448.    PicZ.FillStyle = 1
  449.    picP.FillStyle = 1
  450.    PicX.FillStyle = 1
  451.    Pic1.FillStyle = 1
  452.    Pic2.FillStyle = 1
  453.    Pic3.FillStyle = 1
  454.    Pic4.FillStyle = 1
  455.    Pic5.FillStyle = 1
  456.    ' Backcolor of PicZ is blue (&H8000000D), the rest are white (&H80000009)
  457.    PicZ.BackColor = &H8000000D
  458.    picP.BackColor = &H80000009
  459.    PicX.BackColor = &H80000009
  460.    Pic1.BackColor = &H80000009
  461.    Pic2.BackColor = &H80000009
  462.    Pic3.BackColor = &H80000009
  463.    Pic4.BackColor = &H80000009
  464.    Pic5.BackColor = &H80000009
  465.     ' Before showing first page, test how many pages are there in total in RTB.
  466.    mTotalPages = PageCtnProc(frmDocPreview.PicX)
  467.     ' Display the No. of total pages available
  468.    txtTotalPages.Text = "Total " & CStr(mTotalPages) & " pages"
  469.     ' Enable/disable page movement buttons
  470.    setPageButtons
  471.    Dim i As Integer
  472.    cboPageNo.Clear
  473.    For i = 1 To mTotalPages
  474.        cboPageNo.AddItem i
  475.    Next i
  476.    cboPageNo.Text = cboPageNo.List(0)
  477.       ' Set max of scroll bars
  478.    VScroll1.Max = 1000
  479.    HScroll1.Max = 1000
  480.       ' For ComboBox list
  481.     cboScale.AddItem "150"
  482.     cboScale.AddItem "100"
  483.     cboScale.AddItem "75"
  484.     cboScale.AddItem "50"
  485.     cboScale.AddItem "25"
  486.     cboScale.Text = cboScale.List(4)      ' i.e. 25%
  487.       ' Instead Selprint whole document content such as:
  488.       '   frmFrame.ActiveForm.ActiveControl.SelPrint frmDocPreview.picX.Hdc
  489.       ' we only print a single page at a time.  Initially we show page 1.
  490.       '
  491.       ' Whatever page, we will print it to PicX first (then project to other
  492.       ' pictureboxes according to the sizes they play)
  493.    mpage = 1
  494.    FormPreviewPage frmDocPreview.PicX, mpage
  495.      ' Now stretchblt to wanted sizes.
  496.     For i = 1 To 5
  497.         DoEvents
  498.         If MakeSizes(i) = False Then
  499.             Screen.MousePointer = vbDefault
  500.             Exit Sub
  501.         End If
  502.     Next
  503.     Screen.MousePointer = vbDefault
  504.      
  505.      ' Start display of preview screen.
  506.      ' Note picZ is always visible, picX always not.
  507.     PicZ.Visible = True
  508.     picP.Visible = False
  509.     PicX.Visible = False
  510.     mNotShow = False        ' Show appropriate picture on screen
  511.     mSizeNo = 5             ' i.e. cboScale.List=4, 25%
  512.     ChangePreview
  513. End Sub
  514. Private Sub cboPageNo_click()
  515.     Dim mpage As Integer
  516.     mpage = cboPageNo.ListIndex + 1
  517.     setPageButtons
  518.     Screen.MousePointer = vbHourglass
  519.      ' Print a new page to PicX
  520.     FormPreviewPage frmDocPreview.PicX, mpage
  521.      ' Again have to stretchblt to various sizes.
  522.     Dim i
  523.     For i = 1 To 5
  524.         DoEvents
  525.         If MakeSizes(i) = False Then
  526.             Screen.MousePointer = vbDefault
  527.             Exit Sub
  528.         End If
  529.     Next
  530.      ' Have to change size (and then change back) to refresh display of new screen
  531.      ' During the change, not to show any picture, hence mNotShow is temporarily
  532.      ' set to True
  533.     If mSizeNo = 1 Then
  534.         mSizeNo = 2
  535.         mNotShow = True
  536.         ChangePreview
  537.         mNotShow = False
  538.         mSizeNo = 1
  539.         ChangePreview
  540.     Else
  541.         mSizeNo = mSizeNo - 1
  542.         mNotShow = True
  543.         ChangePreview
  544.         mNotShow = False
  545.         mSizeNo = mSizeNo + 1
  546.         ChangePreview
  547.     End If
  548.     Screen.MousePointer = vbDefault
  549. End Sub
  550. Private Sub cmdPrevPage_Click()
  551.     If mTotalPages = 1 Then
  552.         Exit Sub
  553.     Else
  554.         If Val(cboPageNo.Text) > 1 Then
  555.             cboPageNo.Text = cboPageNo.List(cboPageNo.ListIndex - 1)
  556.             cboPageNo_click
  557.         End If
  558.     End If
  559. End Sub
  560. Private Sub cmdNextPage_Click()
  561.     If mTotalPages = 1 Then
  562.         Exit Sub
  563.     Else
  564.         If Val(cboPageNo.Text) < mTotalPages Then
  565.              cboPageNo.Text = cboPageNo.List(cboPageNo.ListIndex + 1)
  566.              cboPageNo_click
  567.         End If
  568.     End If
  569. End Sub
  570. Private Sub setPageButtons()
  571.     If mTotalPages = 1 Then
  572.         cmdPrevPage.Enabled = False
  573.         cmdNextPage.Enabled = False
  574.     Else
  575.         If Val(cboPageNo.Text) = 1 Then
  576.              cmdPrevPage.Enabled = False
  577.              cmdNextPage.Enabled = True
  578.         ElseIf Val(cboPageNo.Text) = mTotalPages Then
  579.              cmdPrevPage.Enabled = True
  580.              cmdNextPage.Enabled = False
  581.         Else
  582.              cmdPrevPage.Enabled = True
  583.              cmdNextPage.Enabled = True
  584.         End If
  585.     End If
  586. End Sub
  587. Private Sub HScroll1_Change()
  588.    Select Case mSizeNo
  589.       Case 1
  590.           Pic1.Left = -HScroll1.Value
  591.       Case 2
  592.           Pic2.Left = -HScroll1.Value
  593.       Case 3
  594.           Pic3.Left = -HScroll1.Value
  595.       Case 4
  596.           Pic4.Left = -HScroll1.Value
  597.       Case 5
  598.           Pic5.Left = -HScroll1.Value
  599.    End Select
  600. End Sub
  601. Private Sub VScroll1_Change()
  602.    Select Case mSizeNo
  603.       Case 1
  604.           Pic1.Top = -VScroll1.Value
  605.       Case 2
  606.           Pic2.Top = -VScroll1.Value
  607.       Case 3
  608.           Pic3.Top = -VScroll1.Value
  609.       Case 4
  610.           Pic4.Top = -VScroll1.Value
  611.       Case 5
  612.           Pic5.Top = -VScroll1.Value
  613.    End Select
  614. End Sub
  615. Private Sub ChangePreview()
  616.    Select Case mSizeNo
  617.       Case 1
  618.           If mNotShow = False Then
  619.                Pic1.Visible = True
  620.           Else
  621.                Pic1.Visible = False
  622.           End If
  623.           Pic2.Visible = False
  624.           Pic3.Visible = False
  625.           Pic4.Visible = False
  626.           Pic5.Visible = False
  627.       Case 2
  628.           Pic1.Visible = False
  629.           If mNotShow = False Then
  630.                Pic1.Visible = True
  631.           Else
  632.                Pic2.Visible = False
  633.           End If
  634.           Pic2.Visible = True
  635.           Pic3.Visible = False
  636.           Pic4.Visible = False
  637.           Pic5.Visible = False
  638.       Case 3
  639.           Pic1.Visible = False
  640.           Pic2.Visible = False
  641.           If mNotShow = False Then
  642.                Pic3.Visible = True
  643.           Else
  644.                Pic3.Visible = False
  645.           End If
  646.           Pic4.Visible = False
  647.           Pic5.Visible = False
  648.       Case 4
  649.           Pic1.Visible = False
  650.           Pic2.Visible = False
  651.           Pic3.Visible = False
  652.           If mNotShow = False Then
  653.                Pic4.Visible = True
  654.           Else
  655.                Pic4.Visible = False
  656.           End If
  657.           Pic5.Visible = False
  658.       Case 5
  659.           Pic1.Visible = False
  660.           Pic2.Visible = False
  661.           Pic3.Visible = False
  662.           Pic4.Visible = False
  663.           If mNotShow = False Then
  664.                Pic5.Visible = True
  665.           Else
  666.                Pic5.Visible = False
  667.           End If
  668.    End Select
  669. End Sub
  670. ' Combo does not honour "Change", we use "Click" instead
  671. Private Sub cboScale_Click()
  672.     Select Case cboScale.Text
  673.         Case "150"
  674.             mSizeNo = 1
  675.             cmdZoomIn.Enabled = False
  676.             cmdZoomOut.Enabled = True
  677.         Case "100"
  678.             mSizeNo = 2
  679.         Case "75"
  680.             mSizeNo = 3
  681.         Case "50"
  682.             mSizeNo = 4
  683.         Case "25"
  684.             mSizeNo = 5
  685.             cmdZoomIn.Enabled = True
  686.             cmdZoomOut.Enabled = False
  687.     End Select
  688.     If mSizeNo > 1 And mSizeNo < 5 Then
  689.          cmdZoomIn.Enabled = True
  690.          cmdZoomOut.Enabled = True
  691.     End If
  692.     ChangePreview
  693. End Sub
  694. Private Sub cmdPrint_click()
  695.      gprint = True
  696.      Unload Me
  697. End Sub
  698. Private Sub cmdZoomin_click()
  699.      If mSizeNo = 1 Then
  700.           Exit Sub
  701.      End If
  702.      Select Case mSizeNo
  703.           Case 5
  704.                mSizeNo = 4
  705.                cboScale.Text = cboScale.List(3)
  706.                cmdZoomOut.Enabled = True
  707.           Case 4
  708.                mSizeNo = 3
  709.                cboScale.Text = cboScale.List(2)
  710.           Case 3
  711.                mSizeNo = 2
  712.                cboScale.Text = cboScale.List(1)
  713.           Case 2
  714.                mSizeNo = 1
  715.                cboScale.Text = cboScale.List(0)
  716.                cmdZoomIn.Enabled = False
  717.      End Select
  718.      If mSizeNo > 1 And mSizeNo < 5 Then
  719.               cmdZoomIn.Enabled = True
  720.               cmdZoomOut.Enabled = True
  721.      End If
  722.      ChangePreview
  723. End Sub
  724. Private Sub cmdzoomout_click()
  725.     If mSizeNo = 5 Then
  726.          Exit Sub
  727.     End If
  728.     Select Case mSizeNo
  729.          Case 1
  730.               cmdZoomIn.Enabled = True
  731.               mSizeNo = 2
  732.               cboScale.Text = cboScale.List(1)
  733.          Case 2
  734.               mSizeNo = 3
  735.               cboScale.Text = cboScale.List(2)
  736.          Case 3
  737.               mSizeNo = 4
  738.               cboScale.Text = cboScale.List(3)
  739.          Case 4
  740.               mSizeNo = 5
  741.               cboScale.Text = cboScale.List(4)
  742.               cmdZoomOut.Enabled = False
  743.               cmdZoomIn.Enabled = True
  744.      End Select
  745.      If mSizeNo > 1 And mSizeNo < 5 Then
  746.               cmdZoomIn.Enabled = True
  747.               cmdZoomOut.Enabled = True
  748.      End If
  749.      ChangePreview
  750. End Sub
  751. Private Function MakeSizes(ByVal mofSize As Integer) As Boolean
  752.    Dim xSrc As Long, ySrc As Long
  753.    Dim xDest As Long, yDest As Long
  754.    Dim mSrcWidth As Long, mSrcHeight As Long
  755.    Dim mDestWidth As Long, mDestHeight As Long
  756.    Dim hSrcDC As Long, hDestDC As Long
  757.    Dim mresult
  758.       
  759.    xSrc = 0: ySrc = 0: xDest = 0: yDest = 0
  760.       
  761.    mSrcWidth = PicX.ScaleWidth
  762.    mSrcHeight = PicX.ScaleHeight
  763.    hSrcDC = PicX.hdc
  764.    Select Case mofSize
  765.        Case 1
  766.           mDestWidth = Pic1.ScaleWidth
  767.           mDestHeight = Pic1.ScaleHeight
  768.           hDestDC = Pic1.hdc
  769.           
  770.       Case 2
  771.           mDestWidth = Pic2.ScaleWidth
  772.           mDestHeight = Pic2.ScaleHeight
  773.           hDestDC = Pic2.hdc
  774.        
  775.       Case 3
  776.           mDestWidth = Pic3.ScaleWidth
  777.           mDestHeight = Pic3.ScaleHeight
  778.           hDestDC = Pic3.hdc
  779.           
  780.       Case 4
  781.           mDestWidth = Pic4.ScaleWidth
  782.           mDestHeight = Pic4.ScaleHeight
  783.           hDestDC = Pic4.hdc
  784.       Case 5
  785.           mDestWidth = Pic5.ScaleWidth
  786.           mDestHeight = Pic5.ScaleHeight
  787.           hDestDC = Pic5.hdc
  788.    End Select
  789.    mresult = StretchBlt(hDestDC, xSrc, ySrc, mDestWidth, mDestHeight, hSrcDC, _
  790.    xSrc, ySrc, mSrcWidth, mSrcHeight, SRCCOPY)
  791.    If mresult = 0 Then
  792.        MsgBox "Error occurred in sizing images. Cannot continue"
  793.        MakeSizes = False
  794.    Else
  795.        MakeSizes = True
  796.    End If
  797. End Function
  798. Private Sub cmdClose_Click()
  799.     Unload Me
  800. End Sub
  801. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  802. ' To display the same as it would print on the selected printer
  803. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  804. Function DocWYSIWYG(RTB As Control) As Long
  805.      Dim LeftMargin As Long, RightMargin As Long
  806.      Dim linewidth As Long
  807.      Dim PrinterhDC As Long
  808.      Dim r As Long
  809.      ' Start a print job to initialize printer object
  810.      Printer.Print ""
  811.      Printer.ScaleMode = vbTwips
  812.      LeftMargin = gLeftMargin * 1440
  813.      RightMargin = Printer.Width - gRightMargin * 1440
  814.      linewidth = RightMargin - LeftMargin
  815.        ' Create an hDC on the Printer pointed to by the Printer object
  816.      PrinterhDC = CreateDC(Printer.DriverName, Printer.DeviceName, 0, 0)
  817.      r = SendMessage(RTB.hwnd, EM_SETTARGETDEVICE, PrinterhDC, ByVal linewidth)
  818.        ' Abort the temporary print job used to get printer data.
  819.      Printer.KillDoc
  820.      DocWYSIWYG = linewidth
  821. End Function
  822. Sub FormPreviewPage(inControl As Control, InPage As Integer)
  823.     Dim PageCtn
  824.       ' Clear picture box control
  825.     Set inControl.Picture = LoadPicture
  826.       ' Set printable area rect.
  827.       ' Note in frmDocPreview, scaleModes are all in vbPixels,
  828.       ' have to compute the vbtwips equivalent
  829.     rectPage.Left = 0
  830.     rectPage.Top = 0
  831.     rectPage.Right = inControl.Width * Screen.TwipsPerPixelX
  832.     rectPage.Bottom = inControl.Height * Screen.TwipsPerPixelY
  833.       ' Set rect in which to print (relative to printable area)
  834.     rectDrawTo.Left = gLeftMargin * 1440
  835.     rectDrawTo.Top = gTopMargin * 1440
  836.     rectDrawTo.Right = inControl.Width * Screen.TwipsPerPixelX _
  837.          - gRightMargin * 1440
  838.     rectDrawTo.Bottom = inControl.Height * Screen.TwipsPerPixelY _
  839.          - gBottomMargin * 1440
  840.     mFormatRange.hdc = inControl.hdc           ' Use the same DC for measuring and rendering
  841.     mFormatRange.hdcTarget = inControl.hdc     ' Point at hDC
  842.     mFormatRange.rectRegion = rectDrawTo       ' Area on page to draw to
  843.     mFormatRange.rectPage = rectPage           ' Entire size of page
  844.     mFormatRange.mCharRange.firstChar = 0      ' Start of text
  845.     mFormatRange.mCharRange.lastChar = -1      ' End of the text
  846.     TextLength = Len(frmFrame.ActiveForm.ActiveControl.Text)
  847.     PageCtn = 1
  848.     Do
  849.         newStartPos = SendMessage(frmFrame.ActiveForm.ActiveControl.hwnd, EM_FORMATRANGE, True, mFormatRange)
  850.         If newStartPos >= TextLength Then
  851.             Exit Do
  852.         End If
  853.         If PageCtn = InPage Then
  854.             Exit Do
  855.         End If
  856.         
  857.         ' Clear picture box control
  858.         Set inControl.Picture = LoadPicture
  859.        
  860.         mFormatRange.mCharRange.firstChar = newStartPos       ' Starting position for next page
  861.         
  862.         mFormatRange.hdc = inControl.hdc
  863.         mFormatRange.hdcTarget = inControl.hdc
  864.         
  865.         PageCtn = PageCtn + 1
  866.         DoEvents
  867.     Loop
  868.     dumpaway = SendMessage(inControl.hwnd, EM_FORMATRANGE, False, ByVal CLng(0))
  869. End Sub
  870. ' Test how many pages are there in total
  871. Function PageCtnProc(inControl As Control) As Integer
  872.     Dim mPageCtn As Integer
  873.       ' Set printable area rect.
  874.       ' Note in frmDocPreview, scaleModes are all in vbPixels;
  875.       ' convert them to vbtwips.
  876.     rectPage.Left = 0
  877.     rectPage.Top = 0
  878.     rectPage.Right = inControl.Width * Screen.TwipsPerPixelX
  879.     rectPage.Bottom = inControl.Height * Screen.TwipsPerPixelY
  880.       ' Set rect in which to print (relative to printable area)
  881.     rectDrawTo.Left = gLeftMargin * 1440
  882.     rectDrawTo.Top = gTopMargin * 1440
  883.     rectDrawTo.Right = inControl.Width * Screen.TwipsPerPixelX _
  884.          - gRightMargin * 1440
  885.     rectDrawTo.Bottom = inControl.Height * Screen.TwipsPerPixelY _
  886.          - gBottomMargin * 1440
  887.       ' Set up the print instructions
  888.     mFormatRange.hdc = inControl.hdc            ' Use the same DC for measuring and rendering
  889.     mFormatRange.hdcTarget = inControl.hdc      ' Point at hDC
  890.     mFormatRange.rectRegion = rectDrawTo        ' Area on page to draw to
  891.     mFormatRange.rectPage = rectPage            ' Entire size of page
  892.     mFormatRange.mCharRange.firstChar = 0       ' Start of text
  893.     mFormatRange.mCharRange.lastChar = -1       ' End of the text
  894.     TextLength = Len(frmFrame.ActiveForm.ActiveControl.Text)
  895.     mPageCtn = 1
  896.     Do
  897.           ' Print the page by sending EM_FORMATRANGE message
  898.         newStartPos = SendMessage(frmFrame.ActiveForm.ActiveControl.hwnd, EM_FORMATRANGE, True, mFormatRange)
  899.         If newStartPos >= TextLength Then
  900.             Exit Do
  901.         End If
  902.         mFormatRange.mCharRange.firstChar = newStartPos       ' Starting position for next page
  903.         mFormatRange.hdc = inControl.hdc
  904.         mFormatRange.hdcTarget = inControl.hdc
  905.         
  906.         mPageCtn = mPageCtn + 1
  907.         DoEvents
  908.     Loop
  909.      ' Clear picture box control
  910.     Set inControl.Picture = LoadPicture
  911.     dumpaway = SendMessage(inControl.hwnd, EM_FORMATRANGE, False, ByVal CLng(0))
  912.     PageCtnProc = mPageCtn
  913. End Function
  914. Sub DocPrintProc()
  915.     On Error Resume Next
  916.     DoEvents
  917.       ' Clear picture box control
  918.     Set frmDocPreview.picP.Picture = LoadPicture
  919.     Dim mydialog1 As Object
  920.     Dim mFromPage As Integer, mToPage As Integer, mpage As Integer
  921.     Set mydialog1 = frmFrame.CommonDialog1
  922.     mydialog1.DialogTitle = "Print"
  923.     mydialog1.CancelError = True
  924.        ' Allow user select page range
  925.     mydialog1.Flags = cdlPDReturnDC + cdlPDPageNums
  926.        ' But default to one of these
  927.     If frmFrame.ActiveForm.Text1.SelLength = 0 Then
  928.         mydialog1.Flags = mydialog1.Flags + cdlPDAllPages
  929.     Else
  930.         mydialog1.Flags = mydialog1.Flags + cdlPDSelection
  931.     End If
  932.     mydialog1.ShowPrinter
  933.     If Err = MSComDlg.cdlCancel Then
  934.          Exit Sub
  935.     End If
  936.          ' Since we allow user selection of page(s), we don't use
  937.          ' the following (Note for some printers, have set last
  938.          ' argument to false in selPrint below)
  939.       ' Printer.ScaleLeft = -gLeftMargin * 1440
  940.       ' Printer.ScaleTop = -gTopMargin * 1440
  941.       ' Printer.CurrentX = 0
  942.       ' Printer.CurrentY = 0
  943.       ' frmFrame.ActiveForm.Text1.SelPrint .Hdc, True
  944.     mFromPage = mydialog1.FromPage
  945.     mToPage = mydialog1.ToPage
  946.     If frmFrame.ActiveForm.WindowState <> 1 Then
  947.          ' Make sure RTB to base it's display off of the printer
  948.         DocWYSIWYG frmFrame.ActiveForm.ActiveControl
  949.         frmFrame.ActiveForm.Move 0, 0
  950.     Else
  951.         MsgBox "Cannot proceed with minimized screen"
  952.         Exit Sub
  953.     End If
  954.     'If MsgBox("Proceed to print", vbYesNo + vbQuestion) = vbNo Then
  955.     '    Exit Sub
  956.     'End If
  957.     Printer.Print ""
  958.     Printer.ScaleMode = vbTwips
  959.       ' Set printable rect area
  960.     rectPage.Left = 0
  961.     rectPage.Top = 0
  962.     rectPage.Right = Printer.ScaleWidth
  963.     rectPage.Bottom = Printer.ScaleHeight
  964.       ' Set rect in which to print (relative to printable area)
  965.     rectDrawTo.Left = gLeftMargin * 1440
  966.     rectDrawTo.Top = gTopMargin * 1440
  967.     rectDrawTo.Right = Printer.ScaleWidth - gRightMargin * 1440
  968.     rectDrawTo.Bottom = Printer.ScaleHeight - gBottomMargin * 1440
  969.      ' Dump earlier pages if any to PicP before reaching first wanted page
  970.     mFormatRange.hdc = frmDocPreview.picP.hdc
  971.     mFormatRange.hdcTarget = frmDocPreview.picP.hdc
  972.     newStartPos = 0                                   ' Next char to start
  973.     mFormatRange.rectRegion = rectDrawTo              ' Area on page to draw to
  974.     mFormatRange.rectPage = rectPage                  ' Entire size of page
  975.     mFormatRange.mCharRange.firstChar = newStartPos   ' Start of text
  976.     mFormatRange.mCharRange.lastChar = -1             ' End of the text
  977.     TextLength = Len(frmFrame.ActiveForm.ActiveControl.Text)
  978.       ' Dumping if any
  979.     mpage = 1
  980.     Do
  981.         If mpage = mFromPage Then
  982.             Exit Do
  983.         End If
  984.         
  985.         ' Don't clear picture box control here, unless you want to print
  986.         ' from first page always.
  987.         
  988.           ' Print the page by sending EM_FORMATRANGE message
  989.         newStartPos = SendMessage(frmFrame.ActiveForm.ActiveControl.hwnd, EM_FORMATRANGE, True, mFormatRange)
  990.         
  991.         If newStartPos >= TextLength Then
  992.             Exit Do
  993.         End If
  994.         
  995.         mFormatRange.mCharRange.firstChar = newStartPos             ' Starting position for next page
  996.         
  997.         mFormatRange.hdc = frmDocPreview.picP.hdc
  998.         mFormatRange.hdcTarget = frmDocPreview.picP.hdc
  999.         
  1000.         mpage = mpage + 1
  1001.         DoEvents
  1002.     Loop
  1003.        ' Must cleanse memory here before print, otherwise font will not be right
  1004.     dumpaway = SendMessage(Screen.ActiveForm.ActiveControl.hwnd, EM_FORMATRANGE, False, ByVal CLng(0))
  1005.     If newStartPos >= TextLength Then
  1006.         Exit Sub
  1007.     End If
  1008.         
  1009.        ' Have to reinitialize printer here
  1010.     Printer.Print ""
  1011.     Printer.ScaleMode = vbTwips
  1012.        ' Actual print to printer, starting from the user-selected Page No.
  1013.     mFormatRange.hdc = Printer.hdc
  1014.     mFormatRange.hdcTarget = Printer.hdc
  1015.       ' Update char range
  1016.     mFormatRange.mCharRange.firstChar = newStartPos
  1017.     Do
  1018.           ' Print the page by sending EM_FORMATRANGE message
  1019.         newStartPos = SendMessage(frmFrame.ActiveForm.ActiveControl.hwnd, EM_FORMATRANGE, True, mFormatRange)
  1020.         If newStartPos >= TextLength Then
  1021.             Exit Do
  1022.         End If
  1023.         If mpage = mToPage Then
  1024.             Exit Do
  1025.         End If
  1026.         
  1027.         mFormatRange.mCharRange.firstChar = newStartPos              ' Starting position for next page
  1028.         
  1029.         Printer.NewPage                  ' Move on to next page
  1030.         Printer.Print ""                 ' Re-initialize hDC
  1031.         mFormatRange.hdc = Printer.hdc
  1032.         mFormatRange.hdcTarget = Printer.hdc
  1033.         
  1034.         mpage = mpage + 1
  1035.         DoEvents
  1036.     Loop
  1037.       ' Commit the print job
  1038.     Printer.EndDoc
  1039.       ' Free up memory
  1040.     dumpaway = SendMessage(Screen.ActiveForm.ActiveControl.hwnd, EM_FORMATRANGE, False, ByVal CLng(0))
  1041. End Sub
  1042.